# -*-perl-*-
# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.

=pod
=begin reST
=begin Description
This writer dumps index entries from one or more input files out in
reST format.  The following items are indexed:

1. Inline targets (if ``-W index-inline-targets``)
2. Targets created using a target role (either the target role or some
   other role based upon target) specified with ``-W
   index-role-target``).  The index entry is either the visible text,
   or if there is none, the target name.
3. Indirect targets pointing to indexed targets (if ``-W
   index-indirect-targets``)

The index writer sorts indices from all input files and put them into
a table.  Each row of the table contains an index entry and the
location of the entry in the html version of the source file.  An entry
is also a reference to the definition in the corresponding html file.

This writer uses the following output defines:

-W doc-titles=<0|1>          Put the document title in the index (default is 1).
-W file-suffix=<suffix>      Specify a file suffix to be used for
			     the html version of the source files
			     (default is "html").
-W filename-ext=<ext>        Specify an extension to the filename,
			     (e.g. "_main") so the location of
			     targets becomes <file><ext>.<suffix>
			     (default is "").
-W index-inline-targets=<0|1>
                             Specifies whether inline targets should
                             be indexed (default is 1).
-W index-indirect-targets=<0|1>
                             Specifies whether indirect targets pointing to
                             indexed targets should be indexed (default is 0).
-W index-role-target[=<0|name>]
                             Specifies whether targets originating from an
                             interpreted text role should be indexed,
                             and if so, what role name should be used
                             (default is 0, or if specified with no
                             name, 'target').
-W output-header=<0|1>       Output a title and contents header (default is 1).
-W short-titles=<0|1>        Use short titles (no section titles)
                             in the index (default is 1).
-W title-underline=<char>    Specify the underline character to use
                             for the title in the header (default is '*').
=end Description
=end reST
=cut

# Details about the location of the entry.  The location is either
# "<source>: <section>" if the rst file has sections, or "<source>"
# otherwise. 
# The DOM tree processed here has been transformed. If the rst file
# has one top level section only, this section is moved to the
# document level and the section title is made into the document title
# during the transformation. In this case, <source> would be the title
# of the document (which is also the title for the single top level
# section). Otherwise <source> is the html file name.

sub BEGIN = {
    # My -W flags
    use vars qw($doc_titles $file_suffix $filename_ext
		$index_indirect_targets $index_inline_targets 
		$index_role_target $output_header
		$short_titles $title_underline);

    # Static globals
    use vars qw(%START);
    %START = ('literal'=>'`', 'reference'=>'`', 'target'=>'`',
	      'emphasis'=>'*', 'strong'=>'*', 'interpreted'=>'`');

    # Run-time globals
    use vars qw($MAX_NAME $MAX_SEC @ALL_TARGETS	%INLINE_TARGETS
		@INDIRECT_TARGETS);

    $MAX_NAME = $MAX_SEC = 1;

    # Defaults for -W flags
    $doc_titles             = 1      unless defined $doc_titles;
    $file_suffix            = 'html' unless defined $file_suffix;
    $filename_ext           = ''     unless defined $filename_ext;
    $index_indirect_targets = 1      unless defined $index_indirect_targets;
    $index_inline_targets   = 1      unless defined $index_inline_targets;
    $index_role_target      = 0      unless defined $index_role_target;
    $index_role_target      = 'target' if ref $index_role_target eq 'SCALAR';
    $output_header          = 1      unless defined $output_header;
    $short_titles           = 1      unless defined $short_titles;
    $title_underline        = '*'    unless defined $title_underline;
}

# Final step of sorting indices from multiple files and
# generating the output.
sub END {
    # Sort the indices according to the refname of targets
    my @sorted = sort byUncasedRefName @ALL_TARGETS;
    my $format = "%-4s %-${MAX_NAME}s %s\n";
    my $table = sprintf($format,
			("=" x 4, "=" x $MAX_NAME, "=" x $MAX_SEC));
    my $targets;
    my @anchors;
    foreach (@sorted) {
	my ($refname, $target, $section) = @$_;
	$refname =~ /^[^0-9a-zA-Z]*(.)/;
	my $c1 = uc($1);
	if (! @anchors || $c1 ne $anchors[-1]) {
	    push @anchors, $c1;
	    $c1 = "_`$c1`";
	}
	else {
	    $c1 = "..";
	}
	$table .= sprintf($format, ($c1, "`$refname`__", $section));
	$targets .= "__ $target\n";
    }
    $table .= sprintf($format, ("=" x 4, "=" x $MAX_NAME, "=" x $MAX_SEC));
    my $header = '';
    if ($output_header) {
	my $ul = $title_underline x 5;
	$header = "Index\n$ul\n\n" .
	    ".. compound::\n   :class: contents\n\n" .
	    "   **Contents:**\n\n";
	foreach (@anchors) {
	    $header .= "     `$_`_\n";
	}
	$header .= "\n";
    }
    print $header, $table, "\n", $targets if $targets;
}

sub byUncasedRefName {
    # Compare the reference name, which is the first element in
    # each array.
    my ($x, $y) = (lc($$a[0]), lc($$b[0]));
    # Skip over any non-alphabetic and non-numeric characters
    # at the start
    $x =~ s/^[^a-zA-Z0-9]*//;
    $y =~ s/^[^a-zA-Z0-9]*//;
    return $x cmp $y;
}

sub QuoteStart {
    # Quotes the start of markup with "\ " if it might not be
    # interpreted as starting markup within its context.
    # Also quotes the end with "\ " if it is not followed by
    # an appropriate end-of-markup character.
    my ($dom, $str, $writer) = @_;

    my $parent = $dom->parent();
    my $index = $parent->index($dom);
    my $prevdom = $parent->child($index-1) if $index > 0;
    my $prev = substr($prevdom->{val}, -1)
	if $prevdom && defined $prevdom->{val};
    my $quote = ((!defined $prevdom ||
		  ! defined $START{$prevdom->tag}) &&
		 substr($str,0,2) ne '\ ' &&
		 (defined $prev ?
		  $prev !~ /[$Text::Restructured::MARK_START]/o :
		  ($START{$parent->tag} || '')
		   eq substr($str,0,1))) ?
		   '\ ' : '';
    # We have to force the next DOM to be processed before we can
    # use its 'val' entry.
    my $endquote = '';
    if ($index < $parent->num_contents()-1) {
	my $nextdom = $parent->child($index+1);
	my $nextval = $writer->ProcessDOMPhase($nextdom, 'PROCESS');
	$endquote = '\ '
	    if $nextval !~
	    /^(:?$Text::Restructured::MARK_END_TRAILER)/o;
    }
    return "$quote$str$endquote";
}

phase PROCESS = {
    sub \#PCDATA = {
	my ($dom, $str) = @_;
	return $dom->{text};
    }
    

    # Return the generated section number, without the garbage 
    # characters generated at the end.
    sub generated = {
	my ($dom, $str) = @_;
	# uncoverable condition left note:Always has "classes" attr
	# uncoverable condition right note:First "classes" always "sectnum"
	# uncoverable branch false note:Guards against internal errors
	if ($dom->{attr}{classes} && $dom->{attr}{classes}[0] eq "sectnum") {
	    $str =~ s/^(\d(\.\d)*).*/$1 /;
	    return $str;
	}
    }

    # Return the title.
    sub title = {
	my ($dom, $str) = @_;
	chomp($str);
	return $str;
    }

    # Store the section title in the dom.
    sub section = {
	my ($dom, $str) = @_;
	$dom->{_index}{sectionTitle} = $str;
	return undef;
    }

    # Mark the target to be inline and store refname if it is an
    # inline target. Get rid of "\n" from the refname.
    sub target = {
	my ($dom, $str) = @_;
	# inline target if $str is defined
	if ($dom->{attr}{role}) {
	    if ($dom->{attr}{role} eq $index_role_target) {
		$dom->{_index}{inline} = 1;
		$dom->{_index}{refname} = $str ne '' ? $str :
		    $dom->{attr}{names}[0];
	    }
	}
	elsif ($str && $index_inline_targets) {
	    $dom->{_index}{inline} = 1;
	    $str =~ s/ </ \\</g;
	    $dom->{_index}{refname} = $str;
	}
	$dom->{_index}{refname} =~ s/\n/ /mg if $dom->{_index}{refname};
    }

    sub literal = {
	my ($dom, $str, $writer) = @_;
	return QuoteStart($dom, "``$str``", $writer);
    }

    sub emphasis = {
	my ($dom, $str, $writer) = @_;
	return QuoteStart($dom, "*$str*", $writer);
    }

    sub strong = {
	my ($dom, $str, $writer) = @_;
	return QuoteStart($dom, "**$str**", $writer);
    }

    sub footnote_reference = {
	my ($dom, $str, $writer) = @_;
	return QuoteStart($dom, "[$str]", $writer);
    }

    sub reference = {
	my ($dom, $str, $writer) = @_;
	return QuoteStart($dom, "`$str`", $writer);
    }

    # Store all index entries in the global array.
    sub document = {
	my ($dom, $str)     = @_;
	collectTargets($dom, "");
	my $fileName        = $dom->{attr}{source};
	$fileName .= "$filename_ext.$file_suffix"
	    if $fileName !~ s/\.[^\.\/]*$/$filename_ext\.$file_suffix/o;
	my $title = $str ? $str : $fileName;
	my ($tname, $tdom);
	foreach (sort keys %INLINE_TARGETS) {
	    my $tdom = $INLINE_TARGETS{$_};
	    my $loc = ($tdom->{section} && $title ne $tdom->{section}) ?
		($doc_titles ? "$title: $tdom->{section}" : $tdom->{section} )
		: $title;
	    $loc =~ s/(:\s*(\d+\.)*\d+\.?).*/$1/ if $short_titles;
	    $loc =~ s/([\`\_\*\|\\])/\\$1/go;
	    push @ALL_TARGETS, [$tdom->{_index}{refname},
			       "$fileName#$tdom->{attr}{ids}[0]", $loc];
	    # The refname will show up in the final index table as 
	    # `refname`__
	    $MAX_NAME = length($tdom->{_index}{refname}) + 4
		if ($MAX_NAME < length($tdom->{_index}{refname}) + 4);
	    # The section identifier will show up as it is.
	    $MAX_SEC = length($loc) if ($MAX_SEC < length($loc));
	}

	# Only indirect targets that point to inline targets are indices.
	foreach my $tdom (@INDIRECT_TARGETS) {
	    # Index an indirect target if we index indirect targets
	    # and the thing to which it points is indexed
	    next unless defined $tdom->{attr}{refid};
	    my $target = $tdom->{forward};
	    next if ! defined $target || ! $target->{_index}{refname};
	    my $loc = (defined $target->{section} && $target->{section} ne ''
		       && $title ne $target->{section}) ? 
		       ($doc_titles ? "$title: $target->{section}" :
			$target->{section}) : $title;
	    $loc =~ s/(:\s*(\d+\.)*\d+\.?).*/$1/ if $short_titles;
	    $loc =~ s/([\`\_\*\|\\])/\\$1/go;
	    # Have to reparse the 'lit' in order to get the name with
	    # the proper capitalization!
	    $tdom->{lit} =~ /_(\`?)(.*?)\1:/;
	    my $refname = $2;
	    push @ALL_TARGETS, [$refname,
			       "$fileName#$target->{attr}{ids}[0]", $loc];
	    $MAX_NAME = length($refname) + 4
		if $MAX_NAME < length($refname) + 4;
	}
	# Used in closure of collectTargets
	%INLINE_TARGETS = ();
	@INDIRECT_TARGETS = ();
	return undef;

	# A recursive subroutine to collect all inline internal targets 
	# and indirect targets.
	sub collectTargets {
	    my ($dom, $section) = @_;
	    if ($dom->tag eq 'target' && !$dom->{attr}{anonymous}
		&& !$dom->{attr}{refuri}) {
		if ($dom->{_index}{inline}) {
		    $dom->{section} = $section;
		    $INLINE_TARGETS{$dom->{attr}{ids}[0]} = $dom
			if $dom->{_index}{refname};
		}
		else {
		    push @INDIRECT_TARGETS, $dom;
		}
	    }
	    if ($dom->tag eq 'section') {
		$section = $dom->{_index}{sectionTitle};
	    }
	    foreach ($dom->contents) {
		collectTargets($_, $section);
	    }
	}

    }

    sub .* = {
	my ($dom, $str, $writer) = @_;
	# Handle all the interpreted roles
	return unless exists $Text::Restructured::ROLES{$dom->tag};
	return if $dom->tag eq 'raw' && $dom->{attr}{format} !~ /\bindex\b/;
	return QuoteStart($dom, ":${\$dom->tag}:`$str`", $writer);
    }
}
